Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/Pascal/Applications/NIH Image 1.59/1.59 Source/Analysis.p

Text File | 1995-10-24 | 72.5 KB | 2,475 lines | [TEXT/PJMM]

unit Analysis;

{Analysis routines used by the NIH Image}

interface

    uses
        Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils, Resources, Errors, StandardFile, Palettes, globals, Utilities, LeastSquares, Graphics, file1, file2, Ellipse, Lut;



    procedure DoHistogram;
    procedure GetRectHistogram;
    procedure GetHistogram;
    procedure ShowContinuousHistogram;
    procedure ComputeResults;
    procedure FindThresholdingMode;
    procedure Measure;
    procedure UpdateRoiLineWidth;
    procedure DoProfilePlotOptions;
    procedure ShowResults;
    procedure PlotDensityProfile;
    procedure SetScale;
    procedure Calibrate;
    procedure ResetCounter;
    procedure DoMeasurementOptions;
    procedure DoPoints (event: EventRecord);
    procedure FindAngle (event: EventRecord);
    procedure SaveBlankField;
    procedure UndoLastMeasurement (DisplayResults: boolean);
    procedure MarkSelection (count: integer);
    procedure AutoOutline (start: point);
    procedure RedoMeasurement;
    procedure DeleteMeasurement;
    procedure AnalyzeParticles;
    procedure MakeNonStraightLineRoi (RoiKind: RoiTypeType);
    function isBinaryImage: boolean;
    function DoAPDialog: boolean;


implementation

    const
        UnitsPopUpID = 6;

    var
        WandMode: (LUTMode, GrayMapMode, BinaryMode);
        GrayMapThreshold: integer;
        InfoForRedirect: InfoPtr;
        UnitsKind: UnitsType;



{$PUSH}
{$D-}


procedure DoHistogramOfLine (data: ptr; var histogram: HistogramType; width: LongInt);
{$IFC PowerPC}
VAR
  line:LinePtr;
  i,value:integer;
BEGIN
  line:=LinePtr(data);
  FOR i:=0 TO width-1 DO BEGIN
    value:=line^[i];
    histogram[value]:=histogram[value]+1;
  END;
END;
{$ELSEC}
    {a0=data}
    {a1=histogram}
    {d0=width}
    {d1=pixel value}
    inline
        $4E56, $0000, {  link a6,#0}
        $48E7, $C0C0, {  movem.l a0-a1/d0-d1,-(sp)}
        $206E, $000C, {  move.l 12(a6),a0}
        $226E, $0008, {  move.l 8(a6),a1}
        $202E, $0004, {  move.l 4(a6),d0}
        $5380,       {  subq.l #1,d0}
        $4281,       {L clr.l d1}
        $1218,       {  move.b (a0)+,d1}
        $E541,       {  asl.w #2,d1}
        $52B1, $1800, {  addq.l #1,0(a1,d1.l)}
        $51C8, $FFF4, {  dbra d0,L}
        $4CDF, $0303, {  movem.l (sp)+,a0-a1/d0-d1}
        $4E5E,       {  unlk a6}
        $DEFC, $000C; {  add.w #12,sp}
{$ENDC}


    procedure GetRectHistogram;
        var
            width, i, NumberOfLines: integer;
            offset: LongInt;
            p: ptr;
    begin
        if TooWide then
            exit(GetRectHistogram);
        ShowWatch;
        for i := 0 to 255 do
            Histogram[i] := 0;
        with info^.RoiRect, info^ do begin
                offset := top * BytesPerRow + left;
                p := ptr(ord4(PicBaseAddr) + offset);
                width := right - left;
                NumberOfLines := bottom - top;
            end;
        if width > 0 then
            for i := 1 to NumberOfLines do begin
                    DoHistogramOfLine(p, histogram, width);
                    p := ptr(ord4(p) + info^.BytesPerRow);
                end
    end;


    procedure SetupRedirectedSampling;
        var
            info1, info2, SaveInfo: InfoPtr;
            SameCalibration: boolean;
            i: integer;
    begin
        InfoForRedirect := nil;
        if nPics <> 2 then begin
                PutError('There must be exactly two image windows open to do redirected sampling.');
                AnalyzingParticles := false;
                exit(SetupRedirectedSampling);
            end;
        Info1 := pointer(WindowPeek(PicWindow[1])^.RefCon);
        Info2 := pointer(WindowPeek(PicWindow[2])^.RefCon);
        if not EqualRect(info1^.PicRect, info2^.PicRect) then begin
                PutError('The image windows must be exactly the same size to do redirected sampling.');
                AnalyzingParticles := false;
                exit(SetupRedirectedSampling);
            end;
        if (Info1^.fit <> uncalibrated) or (Info2^.fit <> uncalibrated) then begin
                SameCalibration := true;
                if Info1^.fit <> Info2^.fit then
                    SameCalibration := false;
                if Info1^.nCoefficients <> Info2^.nCoefficients then
                    SameCalibration := false;
                for i := 1 to info1^.nCoefficients do
                    if Info1^.Coefficient[i] <> Info2^.Coefficient[i] then
                        SameCalibration := false;
                if not SameCalibration then begin
                        PutError('Both image must be calibrated the same way to do redirected sampling.');
                        AnalyzingParticles := false;
                        exit(SetupRedirectedSampling);
                    end;
            end;
        if info = info1 then
            InfoForRedirect := info2
        else
            InfoForRedirect := info1;
    end;


    procedure GetHistogram;
        var
            MaskLine, DataLine: LineType;
            width, i, vloc: integer;
            sum, sum2, count, OverFlows: LongInt;
            SaveInfo: InfoPtr;
            value: LongInt;
            trect: rect;
    begin
        if TooWide then
            exit(GetHistogram);
        ShowWatch;
        if RedirectSampling then begin
                SetupRedirectedSampling;
                if InfoForRedirect = nil then
                    exit(GetHistogram);
            end
        else
            InfoForRedirect := nil;
        if not SetupMask then
            beep;
        SaveInfo := Info;
        for i := 0 to 255 do
            Histogram[i] := 0;
        if FitEllipse then
            ResetSums;
        trect := info^.RoiRect;
        with trect do begin
                width := right - left;
                for vloc := top to bottom - 1 do begin
                        if InfoForRedirect <> nil then
                            Info := InfoForRedirect
                        else
                            Info := SaveInfo;
                        GetLine(left, vloc, width, DataLine);
                        Info := UndoInfo;
                        GetLine(left, vloc, width, MaskLine);
                        if FitEllipse then
                            ComputeSums(vloc - top, width, MaskLine);
                        for i := 0 to width - 1 do
                            if MaskLine[i] = BlackIndex then begin
                                    value := band(DataLine[i],255);
                                    histogram[value] := histogram[value] + 1;
                                end;
                    end;
            end;
        Info := SaveInfo;
        if not AnalyzingParticles then
            SetupUndo; {Needed for drawing "marching ants".}
    end;


{$POP}

    procedure ComputeResults;
        var
            MaxCount, icount, isum, n: LongInt;
            i: integer;
            sum, sum2, ri, rcount, tSD, rmode, xc, yc: extended;
            Major, Minor, EllipseAngle, hcenter, vcenter, calValue: extended;
            MinCalibratedValue, MaxCalibratedValue, CalibratedMean: extended;
            IgnoreThresholding: boolean;
            ulength, clength: extended;
    begin
        with info^, results do begin
                case ThresholdingMode of
                    DensitySlice:  begin
                            MinIndex := SliceStart;
                            MaxIndex := SliceEnd;
                        end;
                    GrayMapThresholding:  begin
                            MinIndex := GrayMapThreshold;
                            MaxIndex := 255;
                        end;
                    BinaryImage:  begin
                            MinIndex := BlackIndex;
                            MaxIndex := BlackIndex;
                        end;
                    NoThresholding:  begin
                            MinIndex := 0;
                            MaxIndex := 255;
                        end;
                end;
                IgnoreThresholding := RedirectSampling or (IncludeHoles and (AnalyzingParticles or (CurrentTool = Wand)));
                if IgnoreThresholding then begin
                        MinIndex := 0;
                        MaxIndex := 255;
                    end;
                while (histogram[MinIndex] = 0) and (MinIndex < 255) do
                    MinIndex := MinIndex + 1;
                while (histogram[MaxIndex] = 0) and (MaxIndex > 0) do
                    MaxIndex := MaxIndex - 1;
                MaxCount := 0;
                sum := 0.0;
                isum := 0;
                sum2 := 0.0;
                n := 0;
                minCalibratedValue := 10e100;
                maxCalibratedValue := -10e100;
                rmode := 0.0;
                imode := 0;
                for i := MinIndex to MaxIndex do begin
                        calValue := cvalue[i];
                        icount := histogram[i];
                        rcount := icount;
                        sum := sum + rcount * calValue;
                        isum := isum + icount * i;
                        ri := i;
                        sum2 := sum2 + sqr(calValue) * rcount;
                        n := n + icount;
                        if icount > MaxCount then begin
                                MaxCount := icount;
                                rmode := cvalue[i];
                                imode := i
                            end;
                        if calValue < minCalibratedValue then
                            minCalibratedValue := calValue;
                        if calValue > maxCalibratedValue then
                            maxCalibratedValue := calValue;
                    end;
                if ContinuousHistoGram then
                    exit(ComputeResults);
                if n = 0 then begin
                        minCalibratedValue := 0.0;
                        maxCalibratedValue := 0.0;
                    end;
                if n > 0 then begin
                        CalibratedMean := sum / n;
                        UncalibratedMean := isum / n
                    end
                else begin
                        CalibratedMean := 0.0;
                        UncalibratedMean := 0.0
                    end;
                IncrementCounter;
                mean^[mCount] := CalibratedMean;
                mMin^[mCount] := minCalibratedValue;
                mMax^[mCount] := maxCalibratedValue;
                if mCount <= MaxStandards then
                    umean[mCount] := UncalibratedMean;
                if n > 0 then begin
                        rcount := n;
                        tSD := (rcount * Sum2 - sqr(sum)) / rcount;
                        if tSD > 0.0 then
                            tSD := sqrt(tSD / (rcount - 1.0))
                        else
                            tSD := 0.0
                    end
                else
                    tSD := 0.0;
                sd^[mCount] := tSD;
                PixelCount^[mCount] := n;
                ulength := 0.0;
                clength := 0.0;
                with RoiRect do
                    case RoiType of
                        RectRoi:  begin
                                uLength := ((right - left) + (bottom - top)) * 2.0;
                                cLength := uLength;
                                if SpatiallyCalibrated then
                                    cLength := ((right - left) / xScale + (bottom - top) / yScale) * 2.0;
                            end;
                        OvalRoi:  begin
                                uLength := pi * ((right - left) + (bottom - top)) / 2.0;
                                cLength := uLength;
                                if SpatiallyCalibrated then
                                    cLength := pi * ((right - left) / xScale + (bottom - top) / yScale) / 2.0;
                            end;
                        LineRoi, SegLineRoi, FreeLineRoi:  begin
                                GetLengthOrPerimeter(ulength, clength);
                                nLengths := nLengths + 1;
                            end;
                        PolygonRoi, FreehandRoi, TracedRoi:
                            if (LengthM in Measurements) or (nLengths > 0) or WandAdjustAreas then
                                GetLengthOrPerimeter(ulength, clength);
                        otherwise
                    end;
                if SpatiallyCalibrated then
                    plength^[mCount] := cLength
                else
                    plength^[mcount] := uLength;
                if SpatiallyCalibrated then
                    mArea^[mCount] := n / (xScale * yScale)
                else
                    mArea^[mCount] := n;
                mode^[mCount] := rmode;
                if FitEllipse then begin
                    GetEllipseParam(Major, Minor, EllipseAngle, xc, yc);
                    if InvertYCoordinates then
                        yc := PicRect.bottom - yc;
                    if SpatiallyCalibrated then begin
                            Major := Major / xScale;
                            Minor := Minor / xScale;
                            xc := xc / xScale;
                            yc := yc / yScale;
                        end;
                    MajorAxis^[mCount] := Major * 2.0;
                    MinorAxis^[mCount] := Minor * 2.0;
                    orientation^[mCount] := EllipseAngle;
                    xcenter^[mCount] := xc;
                    ycenter^[mCount] := yc;
                end else begin
                    MajorAxis^[mCount] := 0.0;
                    MinorAxis^[mCount] := 0.0;
                    orientation^[mCount] := 0.0;
                    with RoiRect do begin
                        xc := left + (right - left) / 2.0;
                        yc := top + (bottom - top) / 2.0;
                        if InvertYCoordinates then
                            yc := PicRect.bottom - yc;
                        if SpatiallyCalibrated then begin
                                xc := xc / xScale;
                                yc := yc / yScale;
                            end;
                        xcenter^[mCount] := xc;
                        ycenter^[mCount] := yc;
                    end;
                end;
            end; {with}
        measuring := true;
        InfoMessage := '';
    end;


{$PUSH}
{$D-}


    procedure FindThresholdingMode;
    begin
        with info^ do begin
                if DensitySlicing then
                    ThresholdingMode := DensitySlice
                else if thresholding then begin
                        ThresholdingMode := GrayMapThresholding;
                        GrayMapThreshold := ColorStart;
                        if GrayMapThreshold < 0 then
                            GrayMapThreshold := 0;
                        if GrayMapThreshold > 255 then
                            GrayMapThreshold := 255;
                    end
                else if BinaryPic then
                    ThresholdingMode := BinaryImage
                else
                    ThresholdingMode := NoThresholding;
            end;
    end;


    procedure Measure;
        var
            AutoSelectAll: boolean;
            SaveN: integer;
    begin
        if NotInBounds then
            exit(Measure);
        with info^ do begin
                FindThresholdingMode;
                if ThresholdingMode = BinaryImage then
                    ThresholdingMode := NoThresholding;
                AutoSelectAll := not RoiShowing;
                if AutoSelectAll then
                    SelectAll(false);
                if (RoiType = RectRoi) and (not RedirectSampling) then
                    GetRectHistogram
                else
                    GetHistogram;
                if MeasurementToRedo > 0 then begin
                        SaveN := mCount;
                        mCount := MeasurementToRedo - 1;
                        ComputeResults;
                        ShowInfo;
                        mCount := SaveN;
                        MeasurementToRedo := 0;
                        UpdateList;
                    end
                else begin
                        ComputeResults;
                        ShowInfo;
                        AppendResults;
                        if RoiType = LineRoi then
                            if nLengths = 1 then
                                if not (LengthM in Measurements) then
                                    UpdateList;
                    end;
                RoiShowing := true;
                WhatToUndo := UndoMeasurement;
                if AutoSelectAll then
                    KillRoi;
                UpdateScreen(OldRoiRect);
            end;
    end;


    procedure ShowHistogram;
        var
            htop: integer;
            tport: GrafPtr;
            hrect, prect, srect: rect;
            FirstTime: boolean;
    begin
        GetPort(tPort);
        FirstTime := HistoWindow = nil;
        if FirstTime then begin
                htop := ScreenHeight - hheight - 10;
                SetRect(HistoRect, hleft, htop, hleft + hwidth, htop + hheight);
                HistoWindow := NewWindow(nil, HistoRect, 'Histogram', true, NoGrowDocProc, nil, true, 0);
                WindowPeek(HistoWindow)^.WindowKind := HistoKind;
            end;
        if FirstTime or (VideoControl = nil) then
            SelectWindow(HistoWindow);
        SetPort(HistoWindow);
        InvalRect(HistoWindow^.PortRect);
        SetPort(tPort);
    end;


    procedure ShowContinuousHistogram;
        const
            skip = 10;
        var
            i, NumberOfLines: integer;
            offset: LongInt;
            p: ptr;
    begin
        with info^ do
            if (FrameGrabber = QTvdig) and (PictureType = FrameGrabberType) then
                CopyOffscreen(fgPixMap, osPort^.portPixMap, PicRect, PicRect);
        for i := 0 to 255 do
            Histogram[i] := 0;
        p := ptr(ptr(fgSlotBase));
        NumberOfLines := ((fgHeight) div skip) - 1;
        offset := fgRowBytes * skip;
        for i := 1 to NumberOfLines do begin
                DoHistogramOfLine(p, histogram, fgWidth);
                p := ptr(ord4(p) + offset);
            end;
        ThresholdingMode := NoThresholding;
        HistogramSliceStart := 0;
        HistogramSliceEnd := 255;
        ComputeResults;
        ShowHistogram;
    end;


    procedure DoHistogram;
        var
            AutoSelectAll: boolean;
    begin
        if NotInBounds then
            exit(DoHistogram);
        if digitizing then begin
                if ContinuousHistogram then
                    ContinuousHistogram := false
                else begin
                        ContinuousHistogram := true;
                        if info <> NoInfo then
                            with info^ do begin
                                    RoiType := NoRoi;
                                    RoiRect := SrcRect;
                                end;
                    end;
                exit(DoHistogram)
            end;
        AutoSelectAll := not info^.RoiShowing;
        if AutoSelectAll then
            SelectAll(false);
        if (info^.RoiType = RectRoi) and (not RedirectSampling) then
            GetRectHistogram
        else
            GetHistogram;
        ThresholdingMode := NoThresholding;
        ComputeResults;
        ShowCount := false;
        ShowInfo;
        ShowCount := true;
        FindThresholdingMode;
        case ThresholdingMode of
            DensitySlice:  begin
                    HistogramSliceStart := SliceStart;
                    HistogramSliceEnd := SliceEnd;
                end;
            GrayMapThresholding:  begin
                    HistogramSliceStart := GrayMapThreshold;
                    HistogramSliceEnd := 255;
                end;
            BinaryImage, NoThresholding:  begin
                    HistogramSliceStart := 0;
                    HistogramSliceEnd := 255;
                end;
        end;
        ShowHistogram;
        UndoLastMeasurement(false);
        WhatToUndo := NothingToUndo;
        if AutoSelectAll then
            KillRoi;
    end;


{$POP}

    procedure PlotDensityProfile;
        var
            hloc, vloc, value, width, height, i: integer;
            aLine: LineType;
            sum: array[0..MaxLine] of real;
            start, p1, p2: point;
    begin
        with info^ do
            if RoiShowing then
                case RoiType of
                    LineRoi:  begin
                            PlotLineProfile;
                            exit(PlotDensityProfile);
                        end;
                    FreeLineRoi, SegLineRoi, PolygonRoi, FreehandRoi, TracedRoi:  begin
                            PlotArbitraryLine;
                            exit(PlotDensityProfile);
                        end;
                end; {case}
        if NoSelection or NotRectangular or NotInBounds then
            exit(PlotDensityProfile);
        ShowWatch;
        with info^.RoiRect do begin
                width := right - left;
                height := bottom - top;
                start.h := left;
                start.v := bottom;
                if (width >= height) or (OptionKeyWasDown) then begin
            {Column Average Plot}
                        if width > MaxLine then begin
                            PlotTooLongMsg;
                            exit(PlotDensityProfile);
                        end;
                        for i := 0 to width - 1 do
                            sum[i] := 0.0;
                        for vloc := top to bottom - 1 do begin
                                GetLine(left, vloc, width, aLine);
                                for i := 0 to width - 1 do
                                    sum[i] := sum[i] + cvalue[aLine[i]];
                            end;
                        for i := 0 to width - 1 do
                            PlotData^[i] := sum[i] / height;
                        PlotCount := width;
                        PlotAvg := height;
                        PlotStart.h := left;
                        PlotStart.v := top + (bottom - top) div 2;
                        PlotAngle := 0.0;
                        ComputePlotMinAndMax;
                        if ShowPlot then
                            SetupPlot(start, false);
                    end
                else begin
           {Row Average Plot}
                        if height > MaxLine then begin
                            PlotTooLongMsg;
                            exit(PlotDensityProfile);
                        end;
                        for i := 0 to height - 1 do
                            sum[i] := 0.0;
                        for hloc := left to right - 1 do begin
                                GetColumn(hloc, top, height, aLine);
                                for i := 0 to height - 1 do
                                    sum[i] := sum[i] + cValue[aLine[i]];
                            end;
                        for i := 0 to height - 1 do
                            PlotData^[i] := sum[i] / width;
                        PlotCount := height;
                        PlotAvg := width;
                        PlotStart.h := left + (right - left) div 2;
                        PlotStart.v := top;
                        PlotAngle := 270.0;
                        ComputePlotMinAndMax;
                        if ShowPlot then
                            SetupPlot(start, true);
                    end;
            end; {with}
    end;


    procedure SetScaleUProc (d: DialogPtr; item: integer);
     {User proc for Set Scale dialog box}
        var
            str: str255;
            VersInfo: str255;
            r: rect;
    begin
        SetPort(d);
        GetDItemRect(d, item, r);
        DrawDropBox(r);
        GetMenuItemText(UnitsMenuH, ord(UnitsKind) + 1, str);
        DrawPopUpText(str, r);
    end;


    procedure SetScale;
        const
            MeasuredDistanceID = 3;
            KnownDistanceID = 4;
            AspectRatioID = 5;
            ScaleID = 7;
            UnitsTextID = 8;
        var
            mylog: DialogPtr;
            item, i: integer;
            SaveUnitsKind, OldUnitsKind, MenuUnitsKind: UnitsType;
            KnownDistance, MeasuredDistance, SaveScale, TempScale, CalibratedDistance: extended;
            UnitsPerCM, OldUnitsPerCM, SaveRawScale, SaveAspectRatio: extended;
            ignore, MenuItem: integer;
            str: str255;
            SaveUnits: UnitType;
            isLineSelection: boolean;
            ulength, clength: extended;
            r: rect;
    begin
        if SetScaleUserProc=nil
            then SetScaleUserProc:=NewRoutineDescriptor(@SetScaleUProc, uppUserItemProcInfo, GetCurrentISA);
        with info^ do begin
                if (not RoiShowing) and (CurrentTool = LineTool) and (NoInfo^.roiType = LineRoi) then
                    RestoreRoi;
                isLineSelection := RoiShowing and (RoiType = LineRoi);
                InitCursor;
                if isLineSelection then begin
                        GetLengthOrPerimeter(ulength, clength);
                        MeasuredDistance := ulength;
                    end
                else
                    MeasuredDistance := 0.0;
                if not SpatiallyCalibrated then
                    xUnit := 'pixel';
                GetUnitsKind(UnitsKind, UnitsPerCM);
                SaveUnits := xUnit;
                SaveUnitsKind := UnitsKind;
                SaveScale := xScale;
                SaveAspectRatio := PixelAspectRatio;
                KnownDistance := 0.0;
                mylog := GetNewDialog(10, nil, pointer(-1));
                SetDReal(MyLog, MeasuredDistanceID, MeasuredDistance, 2);
                SetDReal(MyLog, KnownDistanceID, KnownDistance, 2);
                SelectdialogItemText(MyLog, KnownDistanceID, 0, 32767);
                SetDReal(MyLog, AspectRatioID, PixelAspectRatio, 4);
                SetUProc(myLog, UnitsPopupID, handle(SetScaleUserProc));
                if UnitsKind = pixels then
                    TempScale := 1.0
                else
                    TempScale := xScale;
                if trunc(TempScale) = TempScale then
                    SetDReal(MyLog, ScaleID, TempScale, 0)
                else
                    SetDReal(MyLog, ScaleID, TempScale, 5);
                SetDString(MyLog, UnitsTextID, xUnit);
                setport(myLog);
                repeat
                    ModalDialog(nil, item);
                    if item = MeasuredDistanceID then
                        MeasuredDistance := GetDReal(MyLog, MeasuredDistanceID);
                    if item = KnownDistanceID then
                        KnownDistance := GetDReal(MyLog, KnownDistanceID);
                    if item = ScaleID then begin
                            MeasuredDistance := GetDReal(MyLog, ScaleID);
                            KnownDistance := 1;
                            SetDReal(MyLog, MeasuredDistanceID, MeasuredDistance, 2);
                            SetDReal(MyLog, KnownDistanceID, KnownDistance, 2);
                        end;
                    if item = AspectRatioID then begin
                            PixelAspectRatio := GetDReal(MyLog, AspectRatioID);
                            if PixelAspectRatio <= 0.0 then begin
                                    beep;
                                    PixelAspectRatio := 1.0;
                                end;
                        end;
                    if item = UnitsPopUpID then begin
                            OldUnitsKind := UnitsKind;
                            OldUnitsPerCM := UnitsPerCM;
                            GetDItemRect(myLog, item, r);
                            InvertRect(r);
                            MenuItem := PopUpMenu(UnitsMenuH, r.left, r.top, ord(UnitsKind) + 1);
                            InvertRect(r);
                            GetMenuItemText(UnitsMenuH, MenuItem, str);
                            DrawPopUpText(str, r);
                            UnitsKind := UnitsType(MenuItem - 1);
                            GetXUnits(UnitsKind);
                            if (UnitsType(MenuItem - 1) = OtherUnits) and (OldUnitsKind <> OtherUnits) then
                                xUnit := 'unit';
                            SetDString(MyLog, UnitsTextID, xUnit);
                            GetUnitsKind(UnitsKind, UnitsPerCM);
                            if (UnitsPerCM <> OldUnitsPerCM) and (UnitsPerCM <> 0.0) and (OldUnitsPerCM <> 0.0) then
                                    xScale := xScale * (OldUnitsPerCM / UnitsPerCM);
                            if UnitsKind = Pixels then
                                KnownDistance := 0.0;
                        end;
                    if (item = KnownDistanceID) or (item = MeasuredDistanceID) or (item = ScaleID) then
                        if (UnitsKind = Pixels) and (item <> cancel) then
                            PutError('Please select a measurent unit (not pixels) before setting or changing the scale.')
                        else begin
                                if (MeasuredDistance > 0.0) and (KnownDistance > 0.0) then
                                        xScale := MeasuredDistance / KnownDistance;
                            end;
                    if UnitsKind = pixels then
                        TempScale := 1.0
                    else
                        TempScale := xScale;
                    if item <> ScaleID then begin
                            if (trunc(TempScale) = TempScale) or (TempScale >= 10000.0) then
                                SetDReal(MyLog, ScaleID, TempScale, 0)
                            else if TempScale < 0.01 then
                                SetDReal(MyLog, ScaleID, TempScale, 6)
                            else
                                SetDReal(MyLog, ScaleID, TempScale, 3);
                        end;
                    if item = UnitsTextID then begin
                            str := GetDString(myLog, item);
                            TruncateString(str, maxUnit);
                            xUnit := str;
                            GetUnitsKind(UnitsKind, UnitsPerCM);
                            GetDItemRect(myLog, UnitsPopUpID, r);
                            InvalRect(r);
                        end;
                until (item = ok) or (item = cancel);
                DisposeDialog(mylog);
                if item = cancel then begin
                        xUnit := SaveUnits;
                        UnitsKind := SaveUnitsKind;
                        xScale := SaveScale;
                        PixelAspectRatio := SaveAspectRatio;
                    end
                else
                    Changes := true;
                SpatiallyCalibrated := (xScale <> 0.0) and (xUnit <> 'pixel');
                if SpatiallyCalibrated then
                    yScale := xScale / PixelAspectRatio
                else begin
                    UnitsKind := Pixels;
                    UnitsPerCm := 0.0;
                    PixelAspectRatio:=1.0;
                end;
                UpdateTitleBar;
                if item<>cancel then begin
                    NoInfo^.SpatiallyCalibrated:=SpatiallyCalibrated;
                    NoInfo^.xUnit := xUnit;
                    NoInfo^.xScale := xScale;
                    NoInfo^.PixelAspectRatio := PixelAspectRatio;
                end;
            end; {with info^}
    end;


{$PUSH}
{$D-}


    procedure SetupCalibrationPlot;
        const
            hrange = 1024;
            hmax = 1023;
            vrange = 600;
            vmax = 599;
            SymbolSize = 11;
        var
            fRect, tRect: rect;
            svalue, range, hscale, vscale, MinV, MaxV: extended;
            tPort: GrafPtr;
            i, hloc, vloc: integer;
            SaveClipRegion: RgnHandle;
            pt: point;
    begin
        PlotLeftMargin := 60;
        PlotTopMargin := 15;
        PlotBottomMargin := 30;
        PlotRightMargin := 100;
        MinV := minCValue;
        MaxV := maxCValue;
        for i := 1 to nStandards do begin
                svalue := StandardValues[i];
                if svalue < MinV then
                    MinV := svalue;
                if svalue > MaxV then
                    MaxV := svalue;
            end;
        range := MaxV - MinV;
        PlotWidth := hrange div 3 + PlotLeftMargin + PlotRightMargin;
        PlotHeight := vrange div 3 + PlotTopMargin + PlotBottomMargin;
        PlotLeft := 64;
        PlotTop := 64;
        for i := 0 to 255 do
            PlotData^[i] := cvalue[i];
        PlotAvg := 1;
        PlotCount := 256;
        MakePlotWindow(PlotLeft, PlotTop, PlotWidth, PlotHeight);
        if PlotWindow = nil then
            exit(SetupCalibrationPlot);
        WindowPeek(PlotWindow)^.WindowKind := CalibrationPlotKind;
        SetRect(fRect, -SymbolSize, -SymbolSize, hmax + SymbolSize, vmax + SymbolSize);
        GetPort(tPort);
        SetPort(PlotWindow);
        SaveClipRegion := PlotWindow^.ClipRgn;
        RectRgn(PlotWindow^.ClipRgn, fRect);
        hscale := 256.0 / hrange;
        vscale := range / vrange;
        PlotPICT := OpenPicture(fRect);
        for i := 1 to nStandards do begin
                hloc := round(umean[i] / hscale);
                vloc := vmax - round((StandardValues[i] - minCValue) / vscale);
                SetRect(tRect, hloc - SymbolSize, vloc - SymbolSize, hloc + SymbolSize, vloc + SymbolSize);
                FrameOval(tRect);
            end;
        MoveTo(0, vmax - round((cvalue[0] - minCValue) / vscale));
        for i := 1 to 255 do begin
                hloc := round(i / hscale);
                vloc := vmax - round((cvalue[i] - minCValue) / vscale);
                LineTo(hloc, vloc);
            end;
        ClosePicture;
        PlotWindow^.ClipRgn := SaveClipRegion;
        InvalRect(PlotWindow^.PortRect);
        SetPort(tPort);
        SelectWindow(PlotWindow);
    end;


    procedure DoCurveFitting;
        var
            i: integer;
            XData, YData, YFit, Residuals, TempData: ColumnVector;
            Variance: extended;
            SumResidualsSqr, SumStandards, mean, SumMeanDiffSqr, DegreesOfFreedom: extended;
            str1, str2: str255;
    begin
        with info^ do begin
                ShowWatch;
                if fit = RodbardFit then { need to reverse x and y to fit Rodbard equation }
                    for i := 1 to nStandards do begin
                            XData[i] := StandardValues[i];
                            YData[i] := umean[i];
                        end
                else
                    for i := 1 to nStandards do begin
                            XData[i] := umean[i];
                            YData[i] := StandardValues[i];
                        end;
                case fit of
                    StraightLine:
                        nCoefficients := 2;
                    Poly2:
                        nCoefficients := 3;
                    Poly3:
                        nCoefficients := 4;
                    Poly4:
                        nCoefficients := 5;
                    Poly5:
                        nCoefficients := 6;
                    ExpoFit:
                        nCoefficients := 2;
                    PowerFit:
                        nCoefficients := 2;
                    LogFit:
                        nCoefficients := 2;
                    RodbardFit:
                        nCoefficients := 4;
                end;
                DegreesOfFreedom := nStandards - nCoefficients;
                if DegreesOfFreedom < 0 then begin
                        FitGoodness := 0.0;
                        NumToString(nCoefficients, str1);
                        case fit of
                            StraightLine:
                                str2 := 'straight line';
                            Poly2:
                                str2 := '2nd degree polynomial';
                            Poly3:
                                str2 := '3rd degree polynomial';
                            Poly4:
                                str2 := '4th degree polynomial';
                            Poly5:
                                str2 := '5th degree polynomial';
                            ExpoFit:
                                str2 := 'exponential';
                            PowerFit:
                                str2 := 'power';
                            LogFit:
                                str2 := 'log';
                            RodbardFit:
                                str2 := 'Rodbard';
                        end;
                        str2 := concat(' standards to do ', str2, ' fitting.');
                        PutError(concat('You need at least ', str1, str2));
                        AbortMacro;
                        fit:=Uncalibrated;
                        exit(DoCurveFitting)
                    end;
                DoSimplexFit(nStandards, nCoefficients, XData, YData, Coefficient, residuals);
                ZeroClip := true;
                for i := 1 to nStandards do
                    if ydata[i] < 0.0 then
                        ZeroClip := false;
                GenerateValues;
                SumResidualsSqr := 0.0;
                SumStandards := 0.0;
                if fit = RodbardFit then
                    for i := 1 to nStandards do begin
                            tempdata[i] := StandardValues[i];
                            StandardValues[i] := umean[i];
                        end;
                for i := 1 to nStandards do begin
                        SumResidualsSqr := SumResidualsSqr + sqr(residuals[i]);
                        SumStandards := SumStandards + StandardValues[i];
                    end;
                FitSD := Sqrt(SumResidualsSqr / nStandards);
                mean := SumStandards / nStandards;
                SumMeanDiffSqr := 0.0;
                for i := 1 to nStandards do
                    SumMeanDiffSqr := SumMeanDiffSqr + sqr(StandardValues[i] - Mean);
                if (SumMeanDiffSqr > 0.0) and (DegreesOfFreedom <> 0) then
                    FitGoodness := 1 - (SumResidualsSqr / DegreesOfFreedom) * ((nStandards - 1) / SumMeanDiffSqr)
                else
                    FitGoodness := 1.0;
                if fit = RodbardFit then
                    for i := 1 to nStandards do
                        StandardValues[i] := tempdata[i];
            end;
        info^.changes := true;
    end;


    procedure GetStandardsFromFile (mylog: DialogPtr; FirstLevelID, FirstStandardID: integer);
        var
            fname, str: str255;
            RefNum, i, nColumns, nValues: integer;
            rLine: RealLine;
    begin
        RefNum := 0;
        if not GetTextFile(fname, RefNum) then
            exit(GetStandardsFromFile);
        InitTextInput(fname, RefNum);
n
                            umean[item - FirstLevelID + 1] := GetDReal(MyLog, item)
                        else begin
                                PutError('Use the Measure command to record measured values.');
                                if i <= nStandards then begin
                                        RealToString(umean[i], 1, 2, str);
                                        SetDString(MyLog, item, str)
                                    end
                                else
                                    SetDString(MyLog, item, '');
                            end;
                    end;
                if (item >= FirstFitID) and (item <= LastFitID) then begin
                        for i := FirstFitID to LastFitID do
                            SetDlogItem(mylog, i, 0);
                        SetDlogItem(mylog, item, 1);
                        fit := CurveFitType(item - FirstFitID);
                    end;
                if item = UnitOfMeasureID then begin
                    str := GetDString(MyLog, item);
                    TruncateString(str, maxUM);
                    UnitOfMeasure := str;
                end;
                if item = OpenID then begin
                        GetStandardsFromFile(mylog, FirstLevelID, FirstStandardID);
                        nKnownValues := nStandards;
                    end;
                if (item = SaveID) and (nStandards > 1) then
                    SaveStandardsToFile(nStandards);
                if (item = InvertID) and (nStandards > 1) then
                    if InvertOD(NewValues) then
                        for i := 1 to nStandards do begin
                                StandardValues[i] := NewValues[i];
                                SetDReal(MyLog, FirstStandardID + i - 1, StandardValues[i], 5);
                            end;
            until (item = ok) or (item = cancel);
            DisposeDialog(mylog);
            DoCalibrateDialog:=item <> cancel;
        end; {with info^}
    end; {DoCalibrateDialog}


    procedure Calibrate;
        var
            nBadReals, i: integer;
            SaveStandards, temp: StandardsArray;
    begin
        SaveStandards := StandardValues;
        if not macro then
            if not DoCalibrateDialog then begin
                StandardValues := SaveStandards;
                exit(Calibrate);
            end;
        with info^ do begin
                if fit = uncalibrated then begin
                        RemoveDensityCalibration;
                        exit(calibrate)
                    end;
                nBadReals := 0;
                if nStandards > nKnownValues then
                    nStandards := nKnownValues;
                if fit = UncalibratedOD then
                    SetupUncalibratedOD
                else begin
                        for i := 1 to nStandards do
                            if StandardValues[i] = BadReal then
                                nBadReals := nBadReals + 1;
                        if (nStandards > 0) and (nBadReals = 0) then
                            DoCurveFitting
                        else if fit = uncalibrated then
                            beep;
                    end;
                if fit <> uncalibrated then begin
                        if not macro then
                            SetupCalibrationPlot;
                    end;
                NoInfo^.fit := fit;
                NoInfo^.nCoefficients := nCoefficients;
                NoInfo^.Coefficient := Coefficient;
                NoInfo^.ZeroClip := ZeroClip;
                NoInfo^.UnitOfMeasure := UnitOfMeasure;
                if (fit<>StraightLine) or (Coefficient[2] <> -1.0) then
                    InvertPixelValues:=false;
                UpdateTitleBar;
            end; {with info^}
    end; {Calibrate}


    procedure ResetCounter;
        var
            AlertID: Integer;
    begin
        if UnsavedResults and (not macro) then begin
                InitCursor;
                AlertID := alert(500, nil);
            end
        else
            AlertID := ok;
        if AlertID <> CancelResetID then begin
                nPoints := 0;
                nLengths := 0;
                nAngles := 0;
                mCount := 0;
                mCount2 := 0;
                UnsavedResults := false;
                ShowInfo;
                if ResultsWindow <> nil then begin
                        with ListTE^^ do
                            TESetSelect(0, teLength, ListTE);
                        TEDelete(ListTE);
                        UpdateResultsScrollBars;
                    end;
            end;
        measuring := false;
    end;


    procedure ShowResults;
        const
            FontSize = 9;
        var
            wrect, crect, trect: rect;
            loc: point;
    begin
        mCount2 := mCount;
        if ResultsWindow <> nil then begin
                SelectWindow(ResultsWindow);
                exit(ShowResults);
            end;
        CopyResultsToBuffer(1, mCount, true);
        ShowMessage('');
        ResultsWidth := 110 + round(nListColumns * FieldWidth * 6.5);
        if ResultsWidth < 250 then
            ResultsWidth := 250;
        if (ResultsWidth + 20) > ScreenWidth then
            ResultsWidth := ScreenWidth - 20;
        ResultsHeight := ((TextBufLineCount * 2) + 2) * FontSize;
        if ResultsHeight < 200 then
            ResultsHeight := 200;
        if (ResultsHeight + ResultsTop + 50) > ScreenHeight then
            ResultsHeight := ScreenHeight - ResultsTop - 50;
        SetRect(wrect, ResultsLeft, ResultsTop, ResultsLeft + ResultsWidth, ResultsTop + ResultsHeight);
        ResultsWindow := NewWindow(nil, wrect, 'Results', true, 0, pointer(-1), true, 0);
        WindowPeek(ResultsWindow)^.WindowKind := ResultsKind;
        SetRect(crect, ResultsWidth - ScrollBarWidth, -1, ResultsWidth + 1, ResultsHeight - 14);
        vScrollBar := NewControl(ResultsWindow, crect, '', true, 0, 0, ResultsHeight - 14, ScrollBarProc, 0);
        SetRect(crect, -1, ResultsHeight - ScrollBarWidth, ResultsWidth - 14, ResultsHeight + 1);
        hScrollBar := NewControl(ResultsWindow, crect, '', true, 0, 0, ResultsWidth - 14, ScrollBarProc, 0);
        InitResultsTextEdit(Monaco, FontSize);
        DrawControls(ResultsWindow);
        WhatToUndo := NothingToUndo;
    end;


    procedure DoMeasurementOptions;
        const
            FirstID = 3;
            LastID = 15;
            RedirectID = 22;
            IncludeHolesID = 23;
            AutoID = 24;
            AdjustID = 25;
            HeadingsID = 26;
            MaxMeasurementsID = 21;
            WidthID = 19;
            PrecisionID = 17;
        var
            mylog: DialogPtr;
            item, i, SavePrecision, SaveMaxMeasurements, SaveWidth: integer;
            mtype: MeasurementTypes;
            SaveMeasurements: SetOfMeasurements;
            SaveRedirect: boolean;
            SaveAuto, SaveAdjust, SaveHeadings: boolean;
    begin
        InitCursor;
        if nPoints > 0 then
            Measurements := Measurements + [XYLocM];
        if nLengths > 0 then
            Measurements := Measurements + [LengthM];
        if nAngles > 0 then
            Measurements := Measurements + [AngleM];
        SaveMeasurements := measurements;
        SaveRedirect := RedirectSampling;
        SaveWidth := FieldWidth;
        SavePrecision := precision;
        SaveAuto := WandAutoMeasure;
        SaveAdjust := WandAdjustAreas;
        SaveMaxMeasurements := MaxMeasurements;
        SaveHeadings := ShowHeadings;
        mylog := GetNewDialog(4000, nil, pointer(-1));
        mtype := AreaM;
        for i := FirstID to LastID do begin
                if mtype in measurements then
                    SetDlogItem(mylog, i, 1);
                if i <> LastID then
                    mtype := succ(mtype);
            end;
        SetDlogItem(mylog, RedirectID, ord(RedirectSampling));
        SetDlogItem(mylog, IncludeHolesID, ord(IncludeHoles));
        SetDlogItem(mylog, AutoID, ord(WandAutoMeasure));
        SetDlogItem(mylog, AdjustID, ord(WandAdjustAreas));
        SetDlogItem(mylog, HeadingsID, ord(ShowHeadings));
        SetDNum(MyLog, MaxMeasurementsID, MaxMeasurements);
        SetDNum(MyLog, WidthID, FieldWidth);
        SetDNum(MyLog, PrecisionID, precision);
        repeat
            ModalDialog(nil, item);
            if (item >= FirstID) and (item <= LastID) then begin
                    i := item - FirstID;
                    case i of
                        0:
                            mtype := AreaM;
                        1:
                            mtype := MeanM;
                        2:
                            mtype := StdDevM;
                        3:
                            mtype := xyLocM;
                        4:
                            mtype := ModeM;
                        5:
                            mtype := LengthM;
                        6:
                            mtype := MajorAxisM;
                        7:
                            mtype := MinorAxisM;
                        8:
                            mtype := AngleM;
                        9:
                            mtype := IntDenM;
                        10:
                            mtype := MinMaxM;
                        11:
                            mtype := User1M;
                        12:
                            mtype := User2M;
                    end;
                    if mtype in measurements then begin
                            measurements := measurements - [mtype];
                            SetDlogItem(mylog, item, 0)
                        end
                    else begin
                            measurements := measurements + [mtype];
                            SetDlogItem(mylog, item, 1)
                        end;
                end;
            if item = RedirectID then begin
                    RedirectSampling := not RedirectSampling;
                    SetDlogItem(mylog, RedirectID, ord(RedirectSampling));
                end;
            if item = IncludeHolesID then begin
                    IncludeHoles := not IncludeHoles;
                    SetDlogItem(mylog, IncludeHolesID, ord(IncludeHoles));
                end;
            if item = AutoID then begin
                    WandAutoMeasure := not WandAutoMeasure;
                    SetDlogItem(mylog, AutoID, ord(WandAutoMeasure));
                end;
            if item = AdjustID then begin
                    WandAdjustAreas := not WandAdjustAreas;
                    SetDlogItem(mylog, AdjustID, ord(WandAdjustAreas));
                end;
            if item = HeadingsID then begin
                    ShowHeadings := not ShowHeadings;
                    SetDlogItem(mylog, HeadingsID, ord(ShowHeadings));
                end;
            if item = WidthID then
                FieldWidth := GetDNum(MyLog, WidthID);
            if item = PrecisionID then
                precision := GetDNum(MyLog, PrecisionID);
            if item = MaxMeasurementsID then
                MaxMeasurements := GetDNum(MyLog, MaxMeasurementsID);
        until (item = ok) or (item = cancel);
        DisposeDialog(mylog);
        if (FieldWidth < 1) or (FieldWidth > 18) then begin
                FieldWidth := SaveWidth;
                beep;
            end;
        if (precision < 0) or (precision > 8) then begin
                precision := SavePrecision;
                beep;
            end;
        if (MaxMeasurements < 1) or (MaxMeasurements > MaxMaxRegions) then begin
                MaxMeasurements := SaveMaxMeasurements;
                beep;
            end;
        if item = cancel then begin
                measurements := SaveMeasurements;
                RedirectSampling := SaveRedirect;
                FieldWidth := SaveWidth;
                precision := SavePrecision;
                WandAutoMeasure := SaveAuto;
                WandAdjustAreas := SaveAdjust;
                MaxMeasurements := SaveMaxMeasurements;
                ShowHeadings := SaveHeadings;
            end;
        if not (XYLocM in Measurements) then
            nPoints := 0;
        if not (LengthM in Measurements) then
            nLengths := 0;
        if not (AngleM in Measurements) then
            nAngles := 0;
        UpdateFitEllipse;
        if MaxMeasurements <> SaveMaxMeasurements then begin
                PutError('You must quit and restart NIH Image before the change to Max Measurements will take effect.');
                SaveSettings;
                MaxMeasurements:=SaveMaxMeasurements;
            end;
        if (Measurements <> SaveMeasurements) or (SaveWidth <> FieldWidth) or (SavePrecision <> Precision) then
            UpdateList;
    end;


    procedure UpdateRoiLineWidth;
    begin
        with info^, info^.RoiRect do
            if RoiShowing and (RoiType = LineRoi) then begin
                    LX1 := left + LX1;
                    LY1 := top + LY1;
                    LX2 := left + LX2;
                    LY2 := top + LY2;
                    MakeRegion;
                end;
    end;


    procedure DoProfilePlotOptions;
        const
            FixedScaleID = 7;
            MinID = 8;
            MaxID = 9;
            FixedSizeID = 10;
            WidthID = 11;
            HeightID = 12;
            LineWidthID = 13;
            LinePlotID = 14;
            ScatterPlotID = 15;
            InvertID = 16;
            LabelsID = 17;
        var
            mylog: DialogPtr;
            item, i: integer;
            SaveAutoscale, SaveLinePlot, SaveInvert, SaveDrawLabels, SaveFixedSize: boolean;
            SaveWidth, SaveHeight, SaveLineWidth, SaveLineIndex: integer;
            SaveMin, SaveMax: extended;
    begin
        InitCursor;
        SaveAutoscale := AutoscalePlots;
        SaveLinePlot := LinePlot;
        SaveInvert := InvertPlots;
        SaveMin := ProfilePlotMin;
        SaveMax := ProfilePlotMax;
        SaveLineWidth := LineWidth;
        SaveLineIndex := LineIndex;
        SaveWidth := ProfilePlotWidth;
        SaveHeight := ProfilePlotHeight;
        SaveDrawLabels := DrawPlotLabels;
        mylog := GetNewDialog(5000, nil, pointer(-1));
        SetDlogItem(mylog, FixedScaleID, ord(not AutoscalePlots));
        SetDReal(MyLog, MinID, ProfilePlotMin, 2);
        SetDReal(MyLog, MaxID, ProfilePlotMax, 2);
        SetDlogItem(mylog, FixedSizeID, ord(FixedSizePlot));
        SetDNum(MyLog, WidthID, ProfilePlotWidth);
        SetDNum(MyLog, HeightID, ProfilePlotHeight);
        if LinePlot then
            SetDlogItem(mylog, LinePlotID, 1)
        else
            SetDlogItem(mylog, ScatterPlotID, 1);
        if InvertPlots then
            SetDlogItem(mylog, InvertID, 1);
        if DrawPlotLabels then
            SetDlogItem(mylog, LabelsID, 1);
        SetDNum(MyLog, LineWidthID, LineWidth);
        repeat
            ModalDialog(nil, item);
            if item = FixedScaleID then begin
                    AutoscalePlots := not AutoscalePlots;
                    SetDlogItem(mylog, FixedScaleID, ord(not AutoscalePlots));
                end;
            if item = MinID then begin
                    ProfilePlotMin := GetDReal(MyLog, MinID);
                    AutoscalePlots := false;
                    SetDlogItem(mylog, FixedScaleID, 1);
                end;
            if item = MaxID then begin
                    ProfilePlotMax := GetDReal(MyLog, MaxID);
                    AutoscalePlots := false;
                    SetDlogItem(mylog, FixedScaleID, 1);
                end;
            if item = FixedSizeID then begin
                    FixedSizePlot := not FixedSizePlot;
                    SetDlogItem(mylog, FixedSizeID, ord(FixedSizePlot));
                end;
            if item = WidthID then begin
                    ProfilePlotWidth := GetDNum(MyLog, WidthID);
                    if (ProfilePlotWidth < 0) or (ProfilePlotWidth > 1023) then begin
                            ProfilePlotWidth := SaveWidth;
                            SetDNum(MyLog, WidthID, ProfilePlotWidth);
                        end;
                    FixedSizePlot := true;
                    SetDlogItem(mylog, FixedSizeID, 1);
                end;
            if item = HeightID then begin
                    ProfilePlotHeight := GetDNum(MyLog, HeightID);
                    if (ProfilePlotHeight < 0) or (ProfilePlotHeight > 1023) then begin
                            ProfilePlotHeight := SaveHeight;
                            SetDNum(MyLog, HeightID, ProfilePlotHeight);
                        end;
                    FixedSizePlot := true;
                    SetDlogItem(mylog, FixedSizeID, 1);
                end;
            if (item = LinePlotID) or (item = ScatterPlotID) then begin
                    SetDlogItem(mylog, LinePlotID, 0);
                    SetDlogItem(mylog, ScatterPlotID, 0);
                    SetDlogItem(mylog, item, 1);
                    LinePlot := item = LinePlotID;
                end;
            if item = InvertID then begin
                    InvertPlots := not InvertPlots;
                    SetDlogItem(mylog, InvertID, ord(InvertPlots));
                end;
            if item = LabelsID then begin
                    DrawPlotLabels := not DrawPlotLabels;
                    if DrawPlotLabels then {Attempt to fix a "sticky" check box bug.}
                        SetDlogItem(mylog, LabelsID, 1)
                    else
                        SetDlogItem(mylog, LabelsID, 0);
                end;
            if item = LineWidthID then begin
                    LineWidth := GetDNum(MyLog, LineWidthID);
                    if (LineWidth < 1) or (LineWidth > 500) then begin
                            LineWidth := SaveLineWidth;
                            SetDNum(MyLog, LineWidthID, LineWidth);
                        end;
                    ShowLineWidth;
                end;
        until (item = ok) or (item = cancel);
        DisposeDialog(mylog);
        if item = cancel then begin
                ProfilePlotWidth := SaveWidth;
                ProfilePlotHeight := SaveHeight;
                AutoscalePlots := SaveAutoscale;
                LinePlot := SaveLinePlot;
                InvertPlots := SaveInvert;
                ProfilePlotMin := SaveMin;
                ProfilePlotMax := SaveMax;
                DrawPlotLabels := SaveDrawLabels;
                LineWidth := SaveLineWidth;
                if LineIndex <> SaveLineIndex then begin
                        LineIndex := SaveLineIndex;
                        DrawTools;
                    end;
            end;
        if LineWidth <> SaveLineWidth then
            UpdateRoiLineWidth;
        if ProfilePlotMax <= ProfilePlotMin then begin
                ProfilePlotMin := SaveMin;
                ProfilePlotMax := SaveMax;
            end;
    end;


    procedure DoPoints (event: EventRecord);
        var
            loc, tloc: point;
            hloc, vloc, y, offset: LongInt;
            r: rect;
            str, str1, str2: str255;
            Decrement: boolean;
            SaveGDevice: GDHandle;
    begin
        Decrement := false;
        SaveGDevice := GetGDevice;
        SetGDevice(osGDevice);
        SetPort(GrafPtr(info^.osPort));
        pmForeColor(ForegroundIndex);
        loc := event.where;
        ScreenToOffscreen(loc);
        with loc do begin
                hloc := h;
                vloc := v;
            end;
        with results, Info^ do begin
                nPoints := nPoints + 1;
                IncrementCounter;
                if InvertYCoordinates then
                    y := info^.PicRect.bottom - vloc - 1
                else
                    y := vloc;
                ClearResults(mCount);
                PixelCount^[mCount] := 1;
                if SpatiallyCalibrated then
                    mArea^[mCount] := 1.0 / xScale * yScale
                else
                    mArea^[mCount] := 1;
                mean^[mCount] := cvalue[MyGetPixel(hloc, vloc)];
                with info^ do
                    if SpatiallyCalibrated then begin
                            xcenter^[mCount] := hloc / xScale;
                            ycenter^[mCount] := y / yScale;
                        end
                    else begin
                            xcenter^[mCount] := hloc;
                            ycenter^[mCount] := y;
                        end;
            end;
        PenNormal;
        if OptionKeyDown then begin
                NumToString(mCount, str);
                tloc := loc;
                tloc.v := tloc.v + CurrentSize div 3;
                DrawTextString(str, tloc, TeJustCenter);
            end
        else begin
                offset := LineWidth div 2;
                SetRect(r, hloc - offset, vloc - offset, hloc + offset + 1, vloc + offset + 1);
                if ShiftKeyDown then begin
                        Decrement := true;
                        EraseOval(r);
                        mcount := mcount - 2;
                        if mcount <= 0 then begin
                                mcount := 0;
                                UnsavedResults := false;
                            end;
                        nPoints := nPoints - 2;
                        if nPoints < 0 then
                            nPoints := 0;
                    end
                else
                    PaintOval(r);
                UpdateScreen(r);
                if ControlKeyDown then
                    with info^ do begin
                            if SpatiallyCalibrated then begin
                                    RealToString(hloc / xScale, 1, Precision, str1);
                                    RealToString(y / yScale, 1, Precision, str2);
                                end
                            else begin
                                    NumToString(hloc, str1);
                                    NumToString(y, str2);
                                end;
                            tloc := loc;
                            with tloc do begin
                                    h := h + offset + 5;
                                    v := v + CurrentSize div 3;
                                end;
                            str := concat('(', str1, ', ', str2, ')');
                            DrawTextString(str, tloc, TeJustLeft);
                        end; {Control Key Down}
            end;
        SetGDevice(SaveGDevice);
        InfoMessage := '';
        ShowInfo;
        if Decrement then begin
                DeleteLines(mcount + 1, mcount + 1);
                WhatToUndo := NothingToUndo;
            end
        else begin
                AppendResults;
                if (nPoints = 1) then
                    if not (XYlocM in Measurements) then
                        UpdateList;
                measuring := true;
                WhatToUndo := UndoPoint;
            end;
    end;


    procedure FindAngle (event: EventRecord);
        var
            start, finish, OldFinish, MidPoint, first: point;
            ticks: LongInt;
            x1, y1, x2, y2: integer;
            angle, angle1, angle2: extended;
            StartRect: rect;
            FirstLineDone: boolean;
    begin
        if NoUndo then
            exit(FindAngle);
        DrawLabels('Angle:', '', '');
        FlushEvents(EveryEvent, 0);
        start := event.where;
        Pt2Rect(start, start, StartRect);
        InsetRect(StartRect, -2, -2);
        finish := start;
        SetPort(info^.wptr);
        PenNormal;
        PenMode(PatXor);
        PenSize(1, 1);
        MoveTo(start.h, start.v);
        first := start;
        repeat
            repeat
                OldFinish := finish;
                GetMouse(finish);
                MoveTo(start.h, start.v);
                LineTo(OldFinish.h, OldFinish.v);
                MoveTo(start.h, start.v);
                LineTo(finish.h, finish.v);
                ticks := TickCount;
                while ticks = TickCount do
                    ;
                x1 := finish.h - start.h;
                y1 := start.v - finish.v;
                angle1 := GetAngle(x1, info^.PixelAspectRatio * y1);
                Show1Value(angle1, NoValue);
            until GetNextEvent(mUpMask, event);
            FirstLineDone := not PtInRect(finish, StartRect);
            if not FirstLineDone then
                start := finish;
        until FirstLineDone;
        MidPoint := finish;
        x1 := start.h - MidPoint.h;
        y1 := MidPoint.v - start.v;
        angle1 := GetAngle(x1, info^.PixelAspectRatio * y1);
        start := finish;
        finish := start;
        repeat
            OldFinish := finish;
            GetMouse(finish);
            MoveTo(start.h, start.v);
            LineTo(OldFinish.h, OldFinish.v);
            MoveTo(start.h, start.v);
            LineTo(finish.h, finish.v);
            ticks := TickCount;
            while ticks = TickCount do
                ;
            x2 := finish.h - MidPoint.h;
            y2 := MidPoint.v - finish.v;
            angle2 := GetAngle(x2, info^.PixelAspectRatio * y2);
            with results do begin
                    if angle1 >= angle2 then
                        angle := angle1 - angle2
                    else
                        angle := angle2 - angle1;
                    if angle > 180.0 then
                        angle := 360.0 - angle;
                    Show1Value(angle, NoValue);
                end;
        until GetNextEvent(mUpMask, event);
        nAngles := nAngles + 1;
        IncrementCounter;
        ClearResults(mCount);
        Orientation^[mCount] := angle;
        InfoMessage := '';
        ShowInfo;
        AppendResults;
        if nAngles = 1 then
            UpdateList;
        repeat
        until not GetNextEvent(EveryEvent, Event); {FlushEvent doesn't work under A/UX!}
        xCoordinates^[1] := first.h;
        yCoordinates^[1] := first.v;
        xCoordinates^[2] := midpoint.h;
        yCoordinates^[2] := midpoint.v;
        xCoordinates^[3] := finish.h;
        yCoordinates^[3] := finish.v;
        nCoordinates := 3;
        MakeNonStraightLineRoi(SegLineRoi);
    end;


    procedure SaveBlankField;
        var
            SaveInfo: InfoPtr;
            i, xLines, xPixelsPerLine: integer;
            src, dst: ptr;
            SaveFlag: boolean;
            name: str255;
    begin
        if info^.PictureType = FrameGrabberType then begin
                GetWTitle(info^.wptr, name);
                if pos('(Corrected)', name) > 0 then begin
                        PutError('To save a blank field the captured image must be uncorrected.');
                        exit(SaveBlankField);
                    end;
                SaveInfo := info;
                if BlankFieldInfo = nil then begin
                        if not Duplicate('Blank Field', true) then
                            exit(SaveBlankField);
                    end;
                src := info^.PicBaseAddr;
                dst := BlankFieldInfo^.PicBaseAddr;
                with Info^.PicRect do begin
                        xLines := bottom - top;
                        xPixelsPerLine := right - left;
                    end;
                for i := 1 to xLines do begin
                        BlockMove(src, dst, xPixelsPerLine);
                        src := ptr(ord4(src) + info^.BytesPerRow);
                        dst := ptr(ord4(dst) + xPixelsPerLine);
                    end;
                Info := BlankFieldInfo;
                InvertPic;
                SaveFlag := digitizing;
                digitizing := false;
                SelectAll(false);
                ShowCount := false;
                Measure;
                ShowCount := true;
                digitizing := SaveFlag;
                BlankFieldMean := round(results.UncalibratedMean);
                UndoLastMeasurement(false);
                KillRoi;
                UpdatePicWindow;
                info := SaveInfo;
                SelectWindow(Info^.wptr);
            end;
    end;


    procedure UndoLastMeasurement (DisplayResults: boolean);
    begin
        if mCount > 0 then begin
                if DisplayResults then
                    DeleteLines(mCount, mCount);
                mCount := mCount - 1;
                if mCount = 0 then
                    UnsavedResults := false;
            end
        else
            WhatToUndo := NothingToUndo;
        if DisplayResults then
            ShowInfo;
    end;


    function PixelInside (hloc, vloc: integer): boolean;
        var
            value: integer;
    begin
        value := MyGetPixel(hloc, vloc);
        case ThresholdingMode of
            DensitySlice:
                PixelInside := (value >= SliceStart) and (value <= SliceEnd);
            GrayMapThresholding:
                PixelInside := value >= GrayMapThreshold;
            BinaryImage:
                PixelInside := value = BlackIndex;
        end;
    end;


    function TraceEdge (hstart, vstart: integer; StartingDirection: char; var TouchingEdge: boolean): boolean;

   {Traces the points(not pixels) that define the edge of an object using the following}
   {16 entry lookup table and converts the resulting outline to a QuickDraw region.}

      {Index  1234*  Code    Result}

      {0         0000     X      Should never happen}
      {1         000X     R      Go Right}
      {2         00X0     D     Go Down}
      {3         00XX     R     Go Right}
      {4         0X00     U     Go Up}
      {5         0X0X     U     Go Up}
      {6         0XX0     u      Go up or down depending on current direction}
      {7         0XXX     U      Go up}
      {8         X000     L      Go left}
      {9         X00X     l       Go left or right depending on current direction}
      {10        X0X0     D      Go down}
      {11        X0XX     R      Go right}
      {12        XX00     L      Go left}
      {13        XX0X     L      Go left}
      {14        XXX0     D     Go down}
      {15        XXXX     X     Should never happen}

       {*   1=Upper left pixel,  2=Upper right pixel, 3=Lower left pixel, 4=Lower right pixel}

        var
            count, hloc, vloc, index, SaveBackground: integer;
            Saveport: GrafPtr;
            direction, NewDirection: char;
            table: string[16];
            UL, UR, LL, LR, SaveCoordinates: boolean;
            TempRgn: RgnHandle;
    begin
        TouchingEdge := false;
        table := 'XRDRUUuULlDRLLDX';
        GetPort(SavePort);
        SetPort(GrafPtr(info^.osPort));
        if SelectionMode <> NewSelection then
            TempRgn := NewRgn;
        with info^ do begin
                SaveBackground := BackgroundIndex; {We want MyGetPixel to always return 0}
                BackgroundIndex := WhiteIndex;         {for coordinates beyond the edge of the image.}
                PenNormal;
                OpenRgn;
                direction := StartingDirection;
                hloc := hstart;
                vloc := vstart;
                UL := PixelInside(hloc - 1, vloc - 1);
                UR := PixelInside(hloc, vloc - 1);
                LL := PixelInside(hloc - 1, vloc);
                LR := PixelInside(hloc, vloc);
                MoveTo(hstart, vstart);
                SaveCoordinates := not MakingLOI;
                if SaveCoordinates then begin
                        xCoordinates^[1] := hstart;
                        yCoordinates^[1] := vstart;
                    end;
                count := 1;
                repeat
                    if IgnoreParticlesTouchingEdge then
                        with info^.PicRect do
                            TouchingEdge := TouchingEdge or (hloc = left) or (hloc = right) or (vloc = top) or (vloc = bottom);
                    index := 0;
                    if LR then
                        index := bor(index, 1);
                    if LL then
                        index := bor(index, 2);
                    if UR then
                        index := bor(index, 4);
                    if UL then
                        index := bor(index, 8);
                    NewDirection := table[index + 1];
                    if NewDirection = 'u' then begin
                            if direction = 'R' then
                                NewDirection := 'U'
                            else
                                NewDirection := 'D'
                        end;
                    if NewDirection = 'l' then begin
                            if direction = 'U' then
                                NewDirection := 'L'
                            else
                                NewDirection := 'R'
                        end;
                    if NewDirection <> direction then begin
                        LineTo(hloc, vloc);
                        if SaveCoordinates then begin
                                xCoordinates^[count] := hloc;
                                yCoordinates^[count] := vloc;
                                count := count + 1;
                            end;
                    end;
                    case NewDirection of
                        'U':  begin
                                vloc := vloc - 1;
                                LL := UL;
                                LR := UR;
                                UL := PixelInside(hloc - 1, vloc - 1);
                                UR := PixelInside(hloc, vloc - 1);
                            end;
                        'D':  begin
                                vloc := vloc + 1;
                                UL := LL;
                                UR := LR;
                                LL := PixelInside(hloc - 1, vloc);
                                LR := PixelInside(hloc, vloc);
                            end;
                        'L':  begin
                                hloc := hloc - 1;
                                UR := UL;
                                LR := LL;
                                UL := PixelInside(hloc - 1, vloc - 1);
                                LL := PixelInside(hloc - 1, vloc);
                            end;
                        'R':  begin
                                hloc := hloc + 1;
                                UL := UR;
                                LL := LR;
                                UR := PixelInside(hloc, vloc - 1);
                                LR := PixelInside(hloc, vloc);
                            end;
                    end;
                    direction := NewDirection;
                until ((hloc = hstart) and (vloc = vstart) and (direction = StartingDirection)) or (count >= MaxCoordinates);
                LineTo(hstart, vstart);
                if SelectionMode <> NewSelection then
                    CloseRgn(TempRgn)
                else
                    CloseRgn(roiRgn);
                {ShowMessage(StringOf(count, '  ', GetHandleSize(handle(roiRgn)))); beep;}
                with roiRgn^^.rgnBBox do
                    if (count >= MaxCoordinates) or (((right - left) = 0) and ((bottom - top) = 0))  then begin
                        SetEmptyRgn(roiRgn);
                        SetPort(SavePort);
                        TraceEdge := false;
                        BackgroundIndex := SaveBackground;
                        nCoordinates := 0;
                        AbortMacro;
                        PutError(StringOf('Perimeter too long.', cr, '(', count:1, ' coordinates)'));
                        exit(TraceEdge);
                    end;
                if (SelectionMode = AddSelection) then begin
                        if RgnNotTooBig(roiRgn, TempRgn) then
                            UnionRgn(roiRgn, TempRgn, roiRgn);
                    end
                else if (SelectionMode = SubSelection) then begin
                        if RgnNotTooBig(roiRgn, TempRgn) then
                            DiffRgn(roiRgn, TempRgn, roiRgn);
                    end;
                RoiShowing := true;
                roiType := TracedRoi;
                if SelectionMode = SubSelection then
                    UpdateScreen(RoiRect);
                RoiRect := roiRgn^^.rgnBBox;
                BackgroundIndex := SaveBackground;
            end; {with info}
        if SelectionMode <> NewSelection then
            DisposeRgn(TempRgn);
        SetPort(SavePort);
        if SaveCoordinates then begin
                nCoordinates := count - 1;
                MakeCoordinatesRelative;
            end;
        TraceEdge := true;
    end;


    procedure MarkSelection (count: integer);
        var
            SavePort: GrafPtr;
            NumWidth, NumLeft, NumBottom, SaveForegroundIndex: integer;
            RoiWidth, inset, hcenter, vcenter: integer;
            str: str255;
            r: rect;
            OutlineWithEllipse: boolean;
            xc, yc: extended;
            SaveGDevice: GDHandle;
    begin
        OutlineWithEllipse := FitEllipse and OptionKeyWasDown;
        with info^ do begin
                KillRoi;
                SetupUndo;
                WhatToUndo := UndoOutline;
                SaveGDevice := GetGDevice;
                SetGDevice(osGDevice);
                GetPort(SavePort);
                SetPort(GrafPtr(osPort));
                SaveForegroundIndex := ForegroundIndex;
                SetForegroundColor(WhiteIndex);
                PenNormal;
                TextFont(Geneva);
                TextSize(9);
                NumToString(count, str);
                with RoiRect do begin
                        NumWidth := StringWidth(str);
                        if AnalyzingParticles or OutlineWithEllipse then begin
                                xc := xcenter^[count];
                                yc := ycenter^[count];
                                if SpatiallyCalibrated then begin
                                        xc := xc * xScale;
                                        yc := yc * yScale;
                                    end;
                                hcenter := round(xc);
                                vcenter := round(yc);
                                if InvertYCoordinates then
                                    vcenter := PicRect.bottom - vcenter - 1
                            end
                        else begin
                                hcenter := left + (right - left) div 2;
                                vcenter := top + (bottom - top) div 2;
                            end;
                        NumLeft := hcenter - NumWidth div 2;
                        NumBottom := vcenter + 3;
                        if not BinaryPic and not AnalyzingParticles then begin
                                FrameRgn(roiRgn);
                                if OutlineWithEllipse then
                                    DrawEllipse;
                            end;
                    end;
                PenNormal;
                SetRect(r, NumLeft - 1, NumBottom - 9, NumLeft + NumWidth + 1, NumBottom + 1);
                PaintRoundRect(r, 4, 4);
                MoveTo(NumLeft, NumBottom);
                TextMode(srcXor);
                DrawString(str);
                SetForegroundColor(SaveForegroundIndex);
                if not analyzingParticles then
                    UpdateScreen(RoiRect);
                SetPort(SavePort);
                SetGDevice(SaveGDevice);
                changes := true;
            end;
    end;


    function isBinaryImage: boolean;
        var
            SaveRoiRect: rect;
            SaveRedirectFlag: boolean;
    begin
        with info^ do begin
                SaveRoiRect := RoiRect;
                RoiRect := PicRect;
                if RedirectSampling then
                    GetHistogram
                else
                    GetRectHistogram;
                BinaryPic := (histogram[0] + histogram[255]) = PixelsPerLine * nLines;
                isBinaryImage := BinaryPic;
                RoiRect := SaveRoiRect;
            end;
    end;


    function SetupAutoOutline (BinaryPixel: boolean): boolean;
    begin
        SetupAutoOutline := false;
        FindThresholdingMode;
        if (ThresholdingMode = NoThresholding) or MakingLOI then
            if isBinaryImage or BinaryPixel then
                ThresholdingMode := BinaryImage;
        if ThresholdingMode = NoThresholding then begin
                PutError('Sorry, but you must be thresholding, or working with a binary image, to use the wand tool or to do particle analysis.');
                exit(SetupAutoOutline);
            end;
        if (ThresholdingMode = GrayMapThresholding) and (GrayMapThreshold = 0) then begin
                PutError(' Threshold must be non-zero.');
                exit(SetupAutoOutline);
            end;
        if not MakingLOI then
            ShowWatch;
        SetupAutoOutline := true;
    end;


    procedure AutoOutline (start: point);
        var
            hloc, vloc: integer;
            TouchingEdge, BinaryPixel: boolean;
            direction: char;
            count: LongInt;
            Perimeter, CalibratedPerimeter, AspectRatio: extended;
    begin
        with start do
            BinaryPixel := (MyGetPixel(h, v) = WhiteIndex) or (MyGetPixel(h, v) = BlackIndex);
        if not SetupAutoOutline(BinaryPixel) then
            exit(AutoOutline);
        if SelectionMode = NewSelection then
            KillRoi;
        with info^ do begin
                with start do
                    if PixelInside(h, v) then begin
                            repeat
                                h := h + 1;
                            until not PixelInside(h, v) or (h >= PicRect.right);
                            if not PixelInside(h - 1, v - 1) then
                                direction := 'R'
                            else if PixelInside(h, v - 1) then
                                direction := 'L'
                            else
                                direction := 'D';
                        end
                    else begin
                            repeat
                                h := h + 1;
                            until PixelInside(h, v) or (h >= PicRect.right);
                            direction := 'U';
                        end;
                if start.h >= PicRect.right then begin
                        beep;
                        exit(AutoOutline);
                    end;
                if TraceEdge(start.h, start.v, direction, TouchingEdge) then begin
                    if GetHandleSize(handle(roiRgn)) = 10 then
                        roiType := RectRoi;
                    WhatToUndo := NothingToUndo;
                    if WandAutoMeasure and not MakingLOI then begin
                            GetHistogram;
                            ComputeResults;
                            if WandAdjustAreas then begin
                                    GetLengthOrPerimeter(Perimeter, CalibratedPerimeter);
                                    with RoiRect do
                                        AspectRatio := (right - left) / (bottom - top);
                                    count := PixelCount^[mCount] + round(Perimeter / 2.0 + AspectRatio * 1.5);
                                    PixelCount^[mCount] := count;
                                    if SpatiallyCalibrated then
                                        mArea^[mCount] := count / (xScale * yScale)
                                    else
                                        mArea^[mCount] := count;
                                end;
                            ShowInfo;
                            AppendResults;
                            WhatToUndo := UndoMeasurement;
                            if LabelParticles then
                                MarkSelection(mCount);
                        end;
                    if not (WandAutoMeasure and LabelParticles) then
                        RoiShowing := true;
                    if not MakingLOI then
                        UpdateScreen(RoiRect);
                    if not WandAutoMeasure then
                        measuring := false;
                end; {if}
            end; {with info}
    end;


    procedure RedoMeasurement;
        var
            SaveN, temp: integer;
            Canceled: boolean;
    begin
        if not isSelectionTool then begin
                CurrentTool := SelectionTool;
                isSelectionTool := true;
                DrawTools;
            end;
        temp := GetInt('Measurement to Redo:', mCount, Canceled);
        if canceled then
            exit(RedoMeasurement);
        MeasurementToRedo := temp;
        if (MeasurementToRedo >= 1) and (MeasurementToRedo <= mCount) then begin
                SaveN := mCount;
                mCount := MeasurementToRedo;
                ShowInfo;
                mCount := SaveN;
            end
        else begin
                beep;
                MeasurementToRedo := 0;
            end;
    end;


    procedure DeleteMeasurement;
        var
            nToDelete, i: integer;
            Canceled: boolean;
    begin
        nToDelete := GetInt('Measurement to delete:', mCount, Canceled);
        if (nToDelete >= 1) and (nToDelete <= mCount) and not Canceled then begin
                for i := nToDelete to mCount - 1 do begin
                        mean^[i] := mean^[i + 1];
                        sd^[i] := sd^[i + 1];
                        PixelCount^[i] := PixelCount^[i + 1];
                        mArea^[i] := mArea^[i + 1];
                        mode^[i] := mode^[i + 1];
                        IntegratedDensity^[i] := IntegratedDensity^[i + 1];
                        idBackground^[i] := idBackground^[i + 1];
                        xcenter^[i] := xcenter^[i + 1];
                        ycenter^[i] := ycenter^[i + 1];
                        MajorAxis^[i] := MajorAxis^[i + 1];
                        MinorAxis^[i] := MinorAxis^[i + 1];
                        orientation^[i] := orientation^[i + 1];
                        mMin^[i] := mMin^[i + 1];
                        mMax^[i] := mMax^[i + 1];
                        plength^[i] := plength^[i + 1];
                    end; {for}
                mCount := mCount - 1;
                if mCount = 0 then begin
                        UnsavedResults := false;
                        beep;
                    end;
                UpdateList;
            end
        else if not Canceled then
            beep;
    end;


    function DoAPDialog: boolean;
        const
            MinID = 6;
            MaxID = 7;
            LabelID = 8;
            OutlineID = 9;
            IgnoreID = 10;
            IncludeHolesID = 11;
            ResetID = 12;
        var
            mylog: DialogPtr;
            item: integer;
    begin
        InitCursor;
        mylog := GetNewDialog(220, nil, pointer(-1));
        SetDNum(MyLog, MinID, MinParticleSize);
        SetDNum(MyLog, MaxID, MaxParticleSize);
        SetDlogItem(mylog, IgnoreID, ord(IgnoreParticlesTouchingEdge));
        SetDlogItem(mylog, LabelID, ord(LabelParticles));
        SetDlogItem(mylog, OutlineID, ord(OutlineParticles));
        SetDlogItem(mylog, IncludeHolesID, ord(IncludeHoles));
        SetDlogItem(mylog, ResetID, ord(APReset));
        repeat
            ModalDialog(nil, item);
            if item = MinID then
                MinParticleSize := GetDNum(MyLog, MinID);
            if item = MaxID then
                MaxParticleSize := GetDNum(MyLog, MaxID);
            if item = IgnoreID then begin
                    IgnoreParticlesTouchingEdge := not IgnoreParticlesTouchingEdge;
                    SetDlogItem(mylog, IgnoreID, ord(IgnoreParticlesTouchingEdge));
                end;
            if item = LabelID then begin
                    LabelParticles := not LabelParticles;
                    SetDlogItem(mylog, LabelID, ord(LabelParticles));
                end;
            if item = OutlineID then begin
                    OutlineParticles := not OutlineParticles;
                    SetDlogItem(mylog, OutlineID, ord(OutlineParticles));
                end;
            if item = IncludeHolesID then begin
                    IncludeHoles := not IncludeHoles;
                    SetDlogItem(mylog, IncludeHolesID, ord(IncludeHoles));
                end;
            if item = ResetID then begin
                    APReset := not APReset;
                    SetDlogItem(mylog, ResetID, ord(APReset));
                end;
        until (item = ok) or (item = cancel);
        DisposeDialog(mylog);
        if MinParticleSize < 1 then
            MinParticleSize := 1;
        if MaxParticleSize > 9999999 then
            MaxParticleSize := 9999999;
        if MaxParticleSize <= MinParticleSize then begin
                MinParticleSize := 1;
                MaxParticleSize := 999999;
            end;
        DoAPDialog := item <> cancel;
    end;


    procedure AnalyzeParticles;
    {
    Here's how it works:      (thanks to Stein Roervik)
        for each line do
              for each pixel in this line do
                if the pixel value is "inside" the threshold range then
                  trace the edge to mark the object
                  do the measurement
                  fill the object with a colour that is outside the threshold range
                else
                  continue the scan
    }
        var
            hloc, vloc, AlertID, index, MaxTriesPerLine, nParticles: integer;
            SaveSliceState, TouchingEdge, DrawOutlines, AutoSelectAll, finished, OutsideSelection: boolean;
            SaveForegroundIndex, SaveBackgroundIndex, EraseIndex, OutlineIndex: integer;
            tPort: GrafPtr;
            ScanRect: rect;
            side: (TopSide, RightSide, BottomSide, LeftSide);
            dstRgn: rgnHandle;
            StartCount: integer;

        function PixelInside: boolean;
            var
                value: integer;
                offset: LongInt;
                p: ptr;
        begin
            with info^ do begin {MyGetPixel inlined to speed things up.}
                    offset := vloc * BytesPerRow + hloc;
                    p := ptr(ord4(PicBaseAddr) + offset);
                end;
            value := BAND(p^, 255);
            case ThresholdingMode of
                DensitySlice:
                    PixelInside := (value >= SliceStart) and (value <= SliceEnd);
                GrayMapThresholding:
                    PixelInside := value >= GrayMapThreshold;
                BinaryImage:
                    PixelInside := value = BlackIndex;
            end;
        end;

        procedure LabelBlobs;
            var
                i,j: integer;
        begin
            j := 0;
            if (StartCount - 1 + nParticles) <= MaxMeasurements then
                for i := StartCount to mCount do begin
                        MarkSelection(i);
                        j := j + 1;
                        if j mod 50 = 0 then
                            UpdatePicWindow;
                        if CommandPeriod then begin
                                beep;
                                leave;
                            end;
                    end;
        end;


        procedure abort;
        begin
            SetPort(tPort);
            if LabelParticles then
                LabelBlobs;
            DensitySlicing := SaveSliceState;
            SetForegroundColor(SaveForegroundIndex);
            SetBackgroundColor(SaveBackgroundIndex);
            KillRoi;
            UpdatePicWindow;
            WhatToUndo := UndoEdit;
            UndoFromClip := true;
            AnalyzingParticles := false;
            DisposeRgn(dstRgn);
        end;


    begin
        with info^ do begin
                if NotInBounds or NoUndo then
                    exit(AnalyzeParticles);
                if not SetupAutoOutline(false) then
                    exit(AnalyzeParticles);
                if not macro and not OptionKeyWasDown then
                    if not DoAPDialog then
                        exit(AnalyzeParticles);
                AutoSelectAll := not RoiShowing;
                if AutoSelectAll then
                    SelectAll(false);
                ScanRect := RoiRect;
                if not AutoSelectAll then
                    with ScanRect do begin
                            left := picrect.left;
                            right := PicRect.right;
                        end;
                KillRoi;
                if APReset then begin
                        ResetCounter;
                        if mCount > 0 then
                            exit(AnalyzeParticles);
                    end;
                StartCount := mCount + 1;
                UpdatePicWindow;
                SetupUndoFromClip;
                SaveSliceState := DensitySlicing;
                SaveForegroundIndex := ForegroundIndex;
                SaveBackgroundIndex := BackgroundIndex;
                SetForegroundColor(WhiteIndex);
                DensitySlicing := false;
                DrawOutlines := false;
                case ThresholdingMode of
                    DensitySlice:  begin
                            EraseIndex := SliceStart - 1;
                            if EraseIndex < 0 then
                                EraseIndex := WhiteIndex;
                            DrawOutlines := OutlineParticles;
                            OutLineIndex := BlackIndex;
                        end;
                    GrayMapThresholding:  begin
                            EraseIndex := GrayMapThreshold - 1;
                            if EraseIndex < 0 then
                                EraseIndex := WhiteIndex;
                        end;
                    BinaryImage:  begin
                            DrawOutlines := OutlineParticles;
                            OutLineIndex := 254;
                            EraseIndex := 128;
                        end;
                end;
                AnalyzingParticles := true;
                nParticles := 0;
                GetPort(tPort);
                SetPort(GrafPtr(osPort));
                dstRgn := NewRgn;
                SelectionMode := NewSelection;
                ShowWatch;
                with ScanRect do
                    for vloc := top to bottom - 1 do
                        for hloc := left to right - 1 do begin
                                if PixelInside then begin
                                        if TraceEdge(hloc, vloc, 'U', TouchingEdge) then begin
                                                nParticles := nParticles + 1;
                                                RoiShowing := false;
                                                if mCount < MaxMeasurements then begin
                                                        GetHistogram;
                                                        ComputeResults;
                                                    end;
                                                SetBackgroundColor(EraseIndex);
                                                EraseRgn(roiRgn);
                                                if AutoSelectAll then
                                                    OutSideSelection := false
                                                else begin
                                                        SectRgn(roiRgn, NoInfo^.RoiRgn, dstRgn);
                                                        OutSideSelection := EmptyRgn(dstRgn);
                                                    end;
                                                if (PixelCount^[mCount] < MinParticleSize) or (PixelCount^[mCount] > MaxParticleSize) or TouchingEdge or OutsideSelection then begin
                                                        mCount := mCount - 1;
                                                        nParticles := nParticles - 1;
                                                        UpdateScreen(RoiRect);
                                                    end
                                                else begin
                                                        if DrawOutlines then begin
                                                                SetForegroundColor(OutlineIndex);
                                                                FrameRgn(roiRgn);
                                                            end;
                                                        UpdateScreen(RoiRect);
                                                        if nParticles <= MaxMeasurements then
                                                            AppendResults;
                                                        if (nParticles mod 10) = 0 then ShowMessage(long2str(nParticles));
                                                        if nParticles = MaxMeasurements then
                                                            beep;
                                                        if CommandPeriod or (AnalyzingParticles = false) then begin {quit}
                                                                beep;
                                                                abort;
                                                                exit(AnalyzeParticles);
                                                            end; {quit}
                                                    end;
                                            end   {if TraceEdge}
                                            else begin
                                                abort; {perimeter too large}
                                                exit(AnalyzeParticles);
                                            end;
                                    end; {if PixelInside}
                            end; {for}
            end; {with}
        ShowMessage(StringOf('Count=',nParticles:1));
        SetPort(tPort);
        if LabelParticles then
            LabelBlobs;
        DensitySlicing := SaveSliceState;
        SetForegroundColor(SaveForegroundIndex);
        SetBackgroundColor(SaveBackgroundIndex);
        KillRoi;
        UpdatePicWindow;
        if ThresholdingMode = GrayMapThresholding then
            ResetGrayMap;
        WhatToUndo := UndoEdit;
        UndoFromClip := true;
        AnalyzingParticles := false;
        DisposeRgn(dstRgn);
    end;


    procedure MakeNonStraightLineRoi (RoiKind: RoiTypeType);
        var
            i, ff: integer;
            SaveInfo: InfoPtr;
            pt, spt, start: point;
            SaveGDevice: GDHandle;
    begin
        SetupUndoInfoRec;
        SaveInfo := Info;
        Info := UndoInfo;
        SaveGDevice := GetGDevice;
        SetGDevice(osGDevice);
        with info^ do begin
                magnification := SaveInfo^.magnification;
                SrcRect := SaveInfo^.SrcRect;
                BinaryPic := true;
                SetPort(GrafPtr(osPort));
            end;
        pmForeColor(BlackIndex);
        pmBackColor(WhiteIndex);
        PenNormal;
        PenSize(LineWidth, LineWidth);
        EraseRect(info^.PicRect);
        ff := LineWidth div 2;
        if ff < 0 then
            ff := 0;
        MakingLOI := true;
        ConvertCoordinates;
        spt.h := xCoordinates^[1];
        spt.v := yCoordinates^[1];
        MoveTo(spt.h - ff, spt.v - ff);
        for i := 2 to nCoordinates do begin
                pt.h := xCoordinates^[i];
                pt.v := yCoordinates^[i];
                LineTo(pt.h - ff, pt.v - ff);
            end;
        start := spt;
        start.h := start.h - 1;
        AutoOutline(start);
        MakingLOI := false;
        info^.RoiShowing := false;
        Info := SaveInfo;
        SetGDevice(SaveGDevice);
        with info^ do begin
                CopyRgn(UndoInfo^.roiRgn, roiRgn);
                RoiRect := UndoInfo^.RoiRect;
                SetEmptyRgn(UndoInfo^.roiRgn);
                RoiShowing := true;
                SetupUndo;
                roiType := RoiKind;
                with RoiRect do begin
                        LX1 := spt.h - left;
                        LY1 := spt.v - top;
                        LX2 := pt.h - left;
                        LY2 := pt.v - top;
                    end;
            end; {with info^}
        MakeCoordinatesRelative;
    end;


end.